home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / profile.el.z / profile.el
Encoding:
Text File  |  1998-05-21  |  5.4 KB  |  147 lines
  1. ;;; profile.el --- basic profiling commands for XEmacs
  2.  
  3. ;; Copyright (C) 1996 Ben Wing, (C) 1997 Free Software Foundation.
  4.  
  5. ;; Maintainer: XEmacs Development Team
  6. ;; Keywords: internal
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  22. ;; Free Software Foundation, 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Synched up with: Not in FSF.
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; In addition to Lisp-based `elp', XEmacs provides a set of
  30. ;; primitives able to profile evaluation of Lisp functions, created by
  31. ;; the illustrious Ben Wing.  The functions in this file can be used
  32. ;; to gain easy access to the internal profiling functions.
  33.  
  34. ;; The profiler works by catching "ticks" (actually SIGPROF signals),
  35. ;; and looking at the current Lisp function, at the time of each tick.
  36. ;; The output of this process is an alist with keys being the
  37. ;; functions, and values being the number of ticks per function.  From
  38. ;; this, `profiling-results' easily extracts the total number of
  39. ;; Unless stated otherwise, profiling info is being accumulated
  40. ;; incrementally through several profile runs (the current info is
  41. ;; always available by `get-profiling-info').  Use
  42. ;; `clear-profiling-info' to break the accumulation chain.
  43.  
  44. ;; Caveats (ELP users should read this):
  45. ;; 1) The time reported is function time, rather than
  46. ;;    function+descendants time;
  47. ;; 2) Each tick is equivalent to 1ms (which can be changed), but this
  48. ;;    is CPU time (user+kernel), not the real time;
  49. ;; 3) Only the actuall funcalls are profiled.  If a subr Ffoo calls
  50. ;;    Fbar using Fbar (), only Ffoo will appear in the profile.
  51.  
  52. ;; A typical profiling session consists of using `clear-profiling-info'
  53. ;; followed by `profile' or `profile-key-sequence', followed by
  54. ;; `profiling-results'.
  55.  
  56. ;; For instance, to see where Gnus spends time when generating Summary
  57. ;; buffer, go to the group buffer, and press `M-x clear-profiling-info'
  58. ;; followed by `M-x profile-key-sequence RET SPC'.
  59.  
  60.  
  61. ;;; Code:
  62.  
  63. ;;;###autoload
  64. (defun profile-results (&optional info stream)
  65.   "Print profiling info INFO to STREAM in a pretty format.
  66. If INFO is omitted, the current profiling info is retrieved using
  67.  `get-profiling-info'.
  68. If STREAM is omitted, either a *Profiling Results* buffer or standard
  69.  output are used, depending on whether the function was called
  70.  interactively or not."
  71.   (interactive)
  72.   (setq info (if info
  73.          (copy-alist info)
  74.            (get-profiling-info)))
  75.   (when (and (not stream)
  76.          (interactive-p))
  77.     (pop-to-buffer (get-buffer-create "*Profiling Results*"))
  78.     (erase-buffer))
  79.   (let ((standard-output (or stream (if (interactive-p)
  80.                     (current-buffer)
  81.                       standard-output)))
  82.     ;; Calculate the longest function
  83.     (maxfunlen (apply #'max
  84.               (length "Function Name")
  85.               (mapcar
  86.                (lambda (el)
  87.                  ;; Functions longer than 50 characters (usually
  88.                  ;; anonymous functions) don't qualify
  89.                  (let ((l (length (format "%s" (car el)))))
  90.                    (if (< l 50)
  91.                    l 0)))
  92.                info))))
  93.     (princ (format "%-*s    Ticks    %%/Total\n" maxfunlen "Function Name"))
  94.     (princ (make-string maxfunlen ?=))
  95.     (princ "    =====    =======\n")
  96.     (let ((sum (float (apply #'+ (mapcar #'cdr info)))))
  97.       (dolist (entry (nreverse (sort info #'cdr-less-than-cdr)))
  98.     (princ (format "%-*s    %-5d    %-6.3f\n"
  99.                maxfunlen (car entry) (cdr entry)
  100.                (* 100 (/ (cdr entry) sum)))))
  101.       (princ (make-string maxfunlen ?-))
  102.       (princ "--------------------\n")
  103.       (princ (format "%-*s    %-5d    %-6.2f\n" maxfunlen "Total" sum 100.0))
  104.       (princ (format "\n\nOne tick = %g ms\n"
  105.              (/ default-profiling-interval 1000.0)))))
  106.   (when (and (not stream)
  107.          (interactive-p))
  108.     (goto-char (point-min))))
  109.  
  110. ;; Support the old name for a while.
  111. (define-obsolete-function-alias 'pretty-print-profiling-info
  112.   'profile-results)
  113.  
  114. ;;;###autoload
  115. (defmacro profile (&rest forms)
  116.   "Turn on profiling, execute FORMS and restore profiling state.
  117. Profiling state here means that if profiling was not in effect when
  118. PROFILE was called, it will be turned off after FORMS are evaluated.
  119. Otherwise, profiling will be left running.
  120.  
  121. Returns the profiling info, printable by `profiling-results'."
  122.   `(let ((was-profiling (profiling-active-p)))
  123.      (unwind-protect
  124.      (progn
  125.        (start-profiling)
  126.        ,@forms)
  127.        (unless was-profiling
  128.      (stop-profiling)))
  129.      (get-profiling-info)))
  130.  
  131. (put 'profile 'lisp-indent-function 0)
  132.  
  133. ;;;###autoload
  134. (defun profile-key-sequence (keys)
  135.   "Dispatch the key sequence KEYS and profile the execution.
  136. KEYS can be a vector of keypress events, a keypress event, or a character.
  137. The function returns the profiling info."
  138.   (interactive "kProfile keystroke: ")
  139.   (and (characterp keys)
  140.        (setq keys (character-to-event keys)))
  141.   (or (vectorp keys)
  142.       (setq keys (vector keys)))
  143.   (profile
  144.     (mapc 'dispatch-event keys)))
  145.  
  146. ;;; profile.el ends here
  147.